Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/CMDLG7/USRWIN_.PAS

Pascal/Delphi Source File | 1992-12-10 | 5KB | 277 lines

{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{   \\\                                    }
{  -(j)-                                   }
{    /juanca                               }
{    ~                                     }
{   ⌐ ACASA 1989-1992, All rights reserved }
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}

{ tUsrWin object, easier to hanlde descendant of tWindow,
  it takes a tPort for painting, instead of a Device Context
  and has a PrintPage method that is called from a tPrinter object
  }

UNIT USRWIN_;
{$C MOVEABLE DEMANDLOAD DISCARDABLE}
INTERFACE
  USES
    WINTYPES,
    OBJECTS,
    OWINDOWS,
    COMMDLG,
    PORT_;

  TYPE
    Super   = TWindow;
    PUsrWin = ^TUsrWin;
    TUsrWin = OBJECT ( Super )

      FUNCTION
        getPort:PPort;
          virtual;

      FUNCTION
      extraText :pChar;
        virtual;

      PROCEDURE
        setText(s:pChar);
          virtual;
      PROCEDURE
      paint(paintDC:HDC; VAR paintInfo:TPaintStruct);
        virtual;
      PROCEDURE
      upaint(dc:pPort; bounds:tRect; erased:Boolean);
        virtual;

      PROCEDURE
      printPage(dc :pPort; page: Word; size: tPoint; var bounds: tRect; pflags: Word);
        virtual;

      PROCEDURE
      getPrintRange(var fromPage, toPage :Word);
        virtual;

      FUNCTION
      printFlags :Longint;
        virtual;

      PROCEDURE
        repaintAll(erase:Boolean);
      PROCEDURE
        repaint(Box:tRect;erase:Boolean);

      PROCEDURE
      setRepaintFlag(onOff :Boolean);

      PROCEDURE
        update;

      PROCEDURE
      move(bounds :tRect; redraw:Boolean);

      FUNCTION
        post(msg, wparam:Word; lparam:Longint):Boolean;
      FUNCTION
        send(msg, wparam:Word; lparam:Longint):Longint;

      PROCEDURE
        getClientRect(var b:tRect);

      PROCEDURE
        alert(msg:pChar);

    END;


{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
IMPLEMENTATION
  USES
    WINPROCS,
    STRINGS;

  {}
  {}
  FUNCTION
  TUsrWin.
  getPort:PPort;
    begin
      getPort := new(PPort, initGet(@self))
    end;

  FUNCTION
  TUsrWin.
  {}
  extraText :pChar;
    begin
      extraText := ''
    end;


  PROCEDURE
  TUsrWin.
  {}
  setText(s:pChar);
    begin
       setWindowText(hWindow, s)
    end;

  PROCEDURE
  tUsrWin.
  {}
  paint(paintDC:HDC; VAR paintInfo:TPaintStruct);
    var
      Box       :tRect;
      dc        :PPort;
      oldCursor :THandle;
    begin
      oldCursor := setCursor(loadCursor(null, idc_Wait));
      dc := getPort;
      dc^.set_context(paintDC);
      with paintInfo
      do
        upaint(dc, rcPaint, fErase);
      dc^.free;
      setCursor(oldCursor);
    end;

  PROCEDURE
  tUsrWin.
  {}
  upaint(dc:PPort; bounds:tRect; erased:Boolean);
    begin
    end;

  PROCEDURE
  tUsrWin.
  {}
  printPage(dc :pPort; page: Word; size: tPoint; var bounds: tRect; pflags: Word);
    begin
      upaint(dc, bounds, TRUE)
    end;

  PROCEDURE
  TUsrWin.
  {}
  getPrintRange(var fromPage, toPage :Word);
    begin
      fromPage := 1;
      toPage   := 1;
    end;

  FUNCTION
  TUsrWin.
  {}
  printFlags :Longint;
    begin
       printFlags :=    pd_ReturnDC or
                        pd_UseDevModeCopies or
                        pd_NoSelection or
                        pd_NoPageNums or
                        pd_NoWarning
    end;


  PROCEDURE
  TUsrWin.
  {}
  repaintAll(erase:Boolean);
    begin
      invalidateRect(hwindow, nil, erase)
    end;

  PROCEDURE
  TUsrWin.
  {}
  repaint(box:tRect; erase:Boolean);
    var
      r  :TRect;
      dc :PPort;
    begin
      dc := getPort;
      dc^.lp2dp(box, 2);
      with box
      do
        setRect(r, left, top, right, bottom);
      invalidateRect(hwindow, @r, erase);
      dc^.free
    end;


  PROCEDURE
  TUsrWin.
  {}
  setRepaintFlag(onOff :Boolean);
    begin
      send(wm_SetRedraw, Word(onOff), null)
    end;


  PROCEDURE
  TUsrWin.
  {}
  getClientRect(var b:tRect);
    var
      r :TRect;
    begin
      WINPROCS.getClientRect(hwindow, r);
    end;


  PROCEDURE
    {}
  alert(win:PWindowsObject; msg:pChar);
    var
      flags:Word;
    begin
      flags :=  mb_Ok or mb_IconExclamation;
      messageBeep(flags);
      messageBox(win^.hwindow, msg, Application^.name, flags);
    end;

  PROCEDURE
  TUsrWin.
    {}
  alert(msg :pChar);
    var
      f:Word;
    begin
      USRWIN_.alert(@self, msg)
    end;

  PROCEDURE
  TUsrWin.
   {}
  update;
    begin
      updateWindow(hwindow)
    end;

  PROCEDURE
  TUsrWin.
   {}
  move(bounds :tRect; redraw:Boolean);
    begin
      with bounds
      do
        moveWindow(hwindow, left, top, left-right, bottom-top, redraw)
    end;

  FUNCTION
  TUsrWin.
    post(msg, wparam:Word; lparam:Longint):Boolean;
      begin
        post := 0 <> Word(postMessage(hwindow, msg, wparam, lparam))
      end;

  FUNCTION
  TUsrWin.
    send(msg, wparam:Word; lparam:Longint):Longint;
      begin
        msg := sendMessage(hwindow, msg, wparam, lparam)
      end;



END.